home *** CD-ROM | disk | FTP | other *** search
/ Super CD / Super CD.iso / geomitri / acad10 / chgtext.lsp < prev    next >
Lisp/Scheme  |  1988-07-15  |  3KB  |  66 lines
  1. ; **********************************************************************
  2. ;                             CHGTEXT.LSP
  3.  
  4. ;  This program will replace every occurrence of an "old string" with a     
  5. ;  "new string".  You will be prompted to select the text you wish
  6. ;  to change.  Then you will be asked to enter the "old string" and 
  7. ;  the "new string".  After the text has been changed, the total number 
  8. ;  of changed lines is displayed.
  9. ; **********************************************************************
  10.  
  11. (defun chgterr (s)
  12.    (if (/= s "Function cancelled")   ; If an error (such as CTRL-C) occurs
  13.       (princ (strcat "\nError: " s)) ; while this command is active...
  14.    )
  15.    (setq p nil)                      ; Free selection set
  16.    (setq *error* olderr)             ; Restore old *error* handler
  17.    (princ)
  18. )
  19.  
  20. (defun C:CHGTEXT (/ p l n e os as ns st s nsl osl sl si chf chm olderr)
  21.    (setq olderr  *error*             ; Initialize variables
  22.          *error* chgterr
  23.          chm     0)
  24.    (setq p (ssget))                  ; Select objects
  25.    (if p (progn                      ; If any objects selected
  26.       (while (= 0 (setq osl (strlen (setq os (getstring t "\nOld string: ")))))
  27.             (princ "Null input invalid")
  28.       )
  29.       (setq nsl (strlen (setq ns (getstring t "\nNew string: "))))
  30.       (setq l 0 n (sslength p))
  31.       (while (< l n)                 ; For each selected object...
  32.          (if (= "TEXT"               ; Look for TEXT entity type (group 0)
  33.                 (cdr (assoc 0 (setq e (entget (ssname p l))))))
  34.             (progn
  35.                (setq chf nil si 1)
  36.                (setq s (cdr (setq as (assoc 1 e))))
  37.                (while (= osl (setq sl (strlen
  38.                              (setq st (substr s si osl)))))
  39.                   (if (= st os)
  40.                       (progn
  41.                         (setq s (strcat (substr s 1 (1- si)) ns
  42.                                         (substr s (+ si osl))))
  43.                         (setq chf t) ; Found old string
  44.                         (setq si (+ si nsl))
  45.                       )
  46.                       (setq si (1+ si))
  47.                   )
  48.                )
  49.                (if chf (progn        ; Substitute new string for old
  50.                   (setq e (subst (cons 1 s) as e))
  51.                   (entmod e)         ; Modify the TEXT entity
  52.                   (setq chm (1+ chm))
  53.                ))
  54.             )
  55.          )
  56.          (setq l (1+ l))
  57.       )
  58.    ))
  59.    (princ "Changed ")                ; Print total lines changed
  60.    (princ chm)
  61.    (princ " text lines.")
  62.    (terpri)
  63.    (setq *error* olderr)             ; Restore old *error* handler
  64.    (princ)
  65. )
  66.